Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/FLAGS.ZIP/FLAGMGR.PRG

Text File | 1996-04-08 | 9KB | 324 lines

SET ESCAPE OFF
SET FORMAT TO fscr NOCLEAR
SET INTENSITY OFF

SELECT a
USE fnames

SELECT b
USE flags INDEX user
COUNT TO e
GOTO TOP

DECLARE usrn[e]

us = 1
DO WHILE us < e
   usrn[us] = usr
   us = us + 1
   SKIP
ENDDO
usrn[us] = usr

DO Scr

tPag = Ceiling(e/17)                   && Total pages
us = 1                                   && Current User
pag = 1                                  && Current page
r = 2                                  && Current r


DO Lst

SET COLOR TO GR+/R
@ r,8 SAY usrn[us]

SET COLOR TO N/N
k = " "
@ 2,0 GET k
DO WHILE .T.
   READ
   DO CASE
      CASE LastKey() = 3                         && <Page Down>
           IF us = e
              LOOP
           ENDIF
           IF pag = tPag
              SET COLOR TO W+/N
              @ r,8 SAY usrn[us]
              r = r + (e - us)
              us = e
              SET COLOR TO GR+/R
              @ r,8 SAY usrn[us]
              LOOP
           ELSE
              IF (us + 20) > e
                 r = r - ((us + 20) - e)
                 us = e
              ELSE
                 us = us + 20
              ENDIF
              pag = pag + 1
           ENDIF

      CASE LastKey() = 5                         && Up Arrow
           IF us = 1
              LOOP
           ENDIF
           IF r = 2
              us = us - 1
              pag = pag - 1
              r = 21
           ELSE
              SET COLOR TO W+/N
              @ r,8 SAY usrn[us]
              r = r - 1
              us = us - 1
              SET COLOR TO GR+/R
              @ r,8 SAY usrn[us]
              LOOP
           ENDIF

      CASE LastKey() = 18                        && <Page Up>
           IF us = 1
              LOOP
           ENDIF
           IF pag = 1
              SET COLOR TO W+/N
              @ r,8 SAY usrn[us]
              r = r - (us - 1)
              us = 1
              SET COLOR TO GR+/R
              @ r,8 SAY usrn[us]
              LOOP
           ELSE
              us = us - 20
              pag = pag - 1
           ENDIF

      CASE LastKey() = 24                        && Down Arrow
           IF us = e
              LOOP
           ENDIF
           IF r = 21
              us = us + 1
              pag = pag + 1
              r = 2
           ELSE
              SET COLOR TO W+/N
              @ r,8 SAY usrn[us]
              r = r + 1
              us = us + 1
              SET COLOR TO GR+/R
              @ r,8 SAY usrn[us]
              LOOP
           ENDIF

      CASE LastKey() = 27                   && <Esc>
           QUIT

      CASE LastKey() = 13                          && <Enter>
           SEEK usrn[us]
           k = " "
           DO WHILE .T.
              SET COLOR TO W+/N
              @ 1,0 CLEAR TO 22,79
              SET COLOR TO B/B
              @ 23,0 CLEAR TO 23,79
              SET COLOR TO GR+/B
              @ 23,5 SAY "<Enter>"
              @ 23,40 SAY "<Esc>"
              SET COLOR TO W+/B
              @ 0,40 SAY "<< " + usrn[us] + " >>"
              @ 23,13 SAY "= Change Flag"
              @ 23,46 SAY "= Return to user list"
              DO fList
              SET FORMAT TO fscr NOCLEAR
              READ
              DO CASE
                 CASE LastKey() = 27
                      EXIT
                 CASE LastKey() = 13
                      ch = "   "
                      nflg = " "
                      SET COLOR TO B/B
                      @ 23,0 CLEAR TO 23,79
                      SET COLOR TO GR+/B
                      @ 23,5 SAY "QIT"
                      SET COLOR TO W+/B
                      @ 23,9 SAY "= Change NO flags"
                      @ 23 40 SAY "Enter flag number/name, and new value"
                      @ 7,25 CLEAR TO 10,45
                      @ 8,27 SAY "Change flag: "
                      @ 9,27 SAY "New Value: "
                      SET FORMAT TO fget NOCLEAR
                      READ
                      DO CASE
                         CASE "V" $ Upper(ch)
                              DO CASE
                                 CASE Upper(nflg) = "Y" .OR. Upper(nflg) = "T"
                                      REPLACE vis WITH .T.
                                 CASE Upper(nflg) = "N" .OR. Upper(nflg) = "F"
                                      REPLACE vis WITH .F.
                                 OTHERWISE
                                      LOOP
                              ENDCASE

                         CASE "R" $ Upper(ch)
                              DO CASE
                                 CASE Upper(nflg) = "Y" .OR. Upper(nflg) = "T"
                                      REPLACE reg WITH .T.
                                 CASE Upper(nflg) = "N" .OR. Upper(nflg) = "F"
                                      REPLACE reg WITH .F.
                                 OTHERWISE
                                      LOOP
                              ENDCASE

                         CASE "A" $ Upper(ch)
                              DO CASE
                                 CASE Upper(nflg) = "Y" .OR. Upper(nflg) = "T"
                                      REPLACE age WITH .T.
                                 CASE Upper(nflg) = "N" .OR. Upper(nflg) = "F"
                                      REPLACE age WITH .F.
                                 OTHERWISE
                                      LOOP
                              ENDCASE

                         CASE "Y" $ Upper(ch)
                              DO CASE
                                 CASE Upper(nflg) = "Y" .OR. Upper(nflg) = "T"
                                      REPLACE ysn WITH .T.
                                 CASE Upper(nflg) = "N" .OR. Upper(nflg) = "F"
                                      REPLACE ysn WITH .F.
                                 OTHERWISE
                                      LOOP
                              ENDCASE

                         CASE "Q" $ Upper(ch)
                              EXIT

                         CASE Val(ch) < 97 .AND. Val(ch) > 0
                              ch = Val(ch)
                              newflg = Stuff(flg,ch,1,nflg)
                              REPLACE flg WITH newflg

                         OTHERWISE
                              LOOP
                      ENDCASE
              ENDCASE
           ENDDO
           SET FORMAT TO fscr NOCLEAR
           DO Scr

      OTHERWISE
           LOOP
   ENDCASE
   DO Lst
   SET COLOR TO GR+/R
   @ r,8 SAY usrn[us]
ENDDO
QUIT

**************************************************
PROCEDURE Scr

SET COLOR TO N/N
@ 0,0 CLEAR
SET COLOR TO B/B
@ 0,0 CLEAR TO 0,79
@ 23,0 CLEAR TO 23,79
SET COLOR TO GR+/B
@ 0,5 SAY "Flag Manager b.03"
@ 23,5 SAY "<Enter>"
@ 23,40 SAY "<Esc>"
SET COLOR TO W+/B
@ 23,13 SAY "= Select User"
@ 23,46 SAY "= Quit"
RETURN

**************************************************
PROCEDURE Lst

PRIVATE r
r = 2
u = Int((pag-1)*20) + 1

SET COLOR TO N/N
@ 2,0 CLEAR TO 20,79
DO WHILE r <= 21
   SET COLOR TO GR+/N
   @ r,1 SAY "["
   @ r,2 SAY u PICTURE "@Z 999"
   @ r,5 SAY "]"
   SET COLOR TO W+/N
   @ r,8 SAY usrn[u]
   IF u = e
      EXIT
   ENDIF
   r = r + 1
   u = u + 1
ENDDO
RETURN

*************************************************
PROCEDURE fList

SELECT a
GOTO TOP
SELECT b

x = 1
y = 0
z = 1
DO WHILE z <= 96
   SET COLOR TO GR+/N
   @ x+1,y+0 SAY LTrim(Str(z))

   SELECT a
   @ x+1,y+5 SAY fnam
   IF z < 96
      SKIP
   ENDIF
   SELECT b

   SET COLOR TO W+/N
   @ x+1,y+3 SAY SubStr(flg,z,1)
   x = x + 1
   z = z + 1
   IF x = 21
      x = 1
      y = y + 15
   ENDIF
ENDDO
SET COLOR TO R+/N
@ 18,60 SAY "VIS"
SET COLOR TO G+/N
@ 19,60 SAY "REG"
SET COLOR TO RB+/N
@ 20,60 SAY "AGE"
SET COLOR TO B+/N
@ 21,60 SAY "YSN"
SET COLOR TO W+/N
IF VIS
   @ 18,64 SAY "YES"
ELSE
   @ 18,64 SAY "NO"
ENDIF
IF REG
   @ 19,64 SAY "YES"
ELSE
   @ 19,64 SAY "NO"
ENDIF
IF AGE
   @ 20,64 SAY "YES"
ELSE
   @ 20,64 SAY "NO"
ENDIF
IF YSN
   @ 21,64 SAY "YES"
ELSE
   @ 21,64 SAY "NO"
ENDIF

RETURN